home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / spiele / brett / dame / dame____.pas next >
Encoding:
Pascal/Delphi Source File  |  1995-08-15  |  37.5 KB  |  1,357 lines
  1. program checkers;
  2.  label 50;
  3.  const
  4.   {$I GEMCONST.PAS}
  5.   MAX                                 = 20;
  6.   MAX360                              = 7200;
  7.   MAX12P12                            = 252;
  8.   MAXP1                               = 21;
  9.  type
  10.   {$I GEMTYPE.PAS}
  11.  var
  12.   mvlst                               : array[0..MAX360] of integer;
  13.   vixbrd,brd,tkn,sw1,sw2,se1,se2      : array[0..32] of integer;
  14.   nw1,nw2,ne1,ne2,oldbrd,clrbrd,kval  : array[0..32] of integer;
  15.   nx,s,e,wx                           : array[0..32] of integer;
  16.   princ                               : array[12..MAX12P12,1..MAX] of integer;
  17.   oldprinc                            : array[12..MAX12P12] of integer;
  18.   tmv                                 : array[0..12] of integer;
  19.   lm                                  : array[1..12] of integer;
  20.   ii,jj,olc                           : array[12..23] of integer;
  21.   dmax,tpc,plyr,nextm,tmvp,code       : integer;
  22.   top,bug,dv,over,alok,near,jedit,jinit : boolean;
  23.   lij,kk,t,big_window,xmax,ymax,wmax,hmax,mul:integer;
  24.   can_mov,clr_brd,title1,title2,edit_brd,init_brd,strt_gme,quit_edi:integer;
  25.   red_top,red_bot,t_black,t_white,comp_p,quit:integer;
  26.   level:array [0..10] of integer;
  27.   dline:array [1..6] of integer;
  28.   sq,c,m_state,dummy,which,mx,my,bs,ws,bp,wp,i,j,n:integer;
  29.   msg:message_buffer;
  30.   a_menu:menu_ptr;
  31.   a,sonia:string;
  32.   ok,full,mono:boolean;
  33.   timelim                             : long_integer;
  34.   d_color:array[0..3] of integer;
  35.   {$I GEMSUBS.PAS}
  36.  
  37.   function s_color(a,b:integer):integer;
  38.     XBIOS(7);
  39.  
  40.   procedure pnt_color(colr:integer);
  41.     begin
  42.       if mono then begin
  43.         if colr=1 then paint_color(0) else paint_color(1);
  44.         if (colr=0) then paint_style(5)
  45.           else paint_style(1);
  46.         if (colr=3) then paint_style(6);
  47.       end
  48.       else paint_color(colr);
  49.     end;
  50.  
  51.   function gia_read(dum:integer):integer;
  52.    xbios(37);
  53.  
  54.   procedure rectangle;
  55.     begin
  56.       hide_mouse;
  57.       frame_rect(50*i+150,(20*j-6)*mul,50,20*mul);
  58.       frame_rect(50*i+151,(20*j-6)*mul,48,20*mul);
  59.       frame_rect(50*i+152,(20*j-6)*mul,46,20*mul);
  60.       show_mouse;
  61.     end;
  62.  
  63.   procedure convert_g(n:integer; var i,j:integer);
  64.     begin
  65.       if not top then n:=33-n;
  66.       j:=(n-1) div 4+1;
  67.       i:=((n-1) mod 4)*2+1;
  68.       if j mod 2=1 then i:=i+1;
  69.     end;
  70.  
  71.   procedure show_move(b:integer);
  72.     var
  73.       c:integer;
  74.     begin
  75.       for c:=b+1 to b+mvlst[b] do
  76.        if mvlst[c]<>99 then begin
  77.         convert_g(abs(mvlst[c]),i,j);
  78.         line_color(0);
  79.         if mono then line_color(1);
  80.         rectangle;
  81.        end;
  82.       repeat
  83.         which:=get_event( E_Button, 1, 1, 1, 0,
  84.                false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  85.                dummy, dummy, dummy, mx, my, dummy );
  86.       until which=E_Button;
  87.       my:=trunc(my/mul);
  88.       for c:=b+1 to b+mvlst[b] do
  89.        if mvlst[c]<>99 then begin
  90.         convert_g(abs(mvlst[c]),i,j);
  91.         line_color(3);
  92.         if mono then begin
  93.           hide_mouse;
  94.           paint_color(1);
  95.           paint_style(6);
  96.           paint_rect(50*i+150,(20*j-6)*mul,50,20*mul);
  97.           show_mouse;
  98.         end
  99.         else rectangle;
  100.        end;
  101.        which:=get_event( E_Button, 1, 0, 1, 0,
  102.                false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  103.                dummy, dummy, dummy, mx, my, dummy );
  104.     end;
  105.  
  106. procedure disp_move;
  107.     var
  108.       c:integer;
  109.       same:boolean;
  110.     begin
  111.       same:=true;
  112.       for c:=13 to lij do
  113.        if olc[c]<>abs(princ[c,1]) then
  114.         same:=false;
  115.       if not same then begin
  116.  
  117.       hide_mouse;
  118.       pnt_color(3);
  119.       for c:=13 to lij do
  120.        if (ii[c]<>0) and (jj[c]<>0) then begin
  121.         i:=ii[c];
  122.         j:=jj[c];
  123.         paint_rect(50*i+150,(20*j-6)*mul,10,4*mul)
  124.        end;
  125.       pnt_color(0);
  126.       for c:=13 to 12+princ[12,1] do
  127.        if princ[c,1]<>99 then begin
  128.         convert_g(abs(princ[c,1]),i,j);
  129.         olc[c]:=abs(princ[c,1]);
  130.         ii[c]:=i;
  131.         jj[c]:=j;
  132.         pnt_color(0);
  133.         paint_rect(50*i+150,(20*j-6)*mul,10,4*mul);
  134.         lij:=c;
  135.        end;
  136.       show_mouse;
  137.  
  138.       end;
  139.     end;
  140.  
  141.   procedure init_screen;
  142.     var
  143.       c,c1,x,y,wm,hm,d:integer;
  144.       title:window_title;
  145.     begin
  146.       if ok then init_mouse;
  147.       hide_mouse;
  148.       if ok then begin
  149.         big_window:=new_window(0,title,0,0,0,0);
  150.         open_window(big_window,0,0,0,0);
  151.         set_window(big_window);
  152.         work_rect(0,d,d,wm,hm);
  153.         paint_outline(false);
  154.         for c:=0 to 3 do
  155.           d_color[c]:=s_color(c,-1);
  156.         if hm>210 then begin
  157.           mono:=true;
  158.           mul:=2;
  159.         end;
  160.         if (wm<600) then begin
  161.           d:=do_alert('[1][ |  | Use medium or high res ][ OK ]',1);
  162.           goto 50;
  163.         end;
  164.       end;
  165.       if not mono then begin
  166.         set_color(1,1000,1000,1000);
  167.         set_color(0,0,0,600); {blue}
  168.         set_color(3,0,600,0); {green}
  169.         set_color(2,750,0,0); {red}
  170.       end;
  171.       pnt_color(0);
  172.       paint_rect(0,0,640,200*mul);
  173.       line_color(1);
  174.       if not mono then begin
  175.         frame_rect(-1,-1,640,188*mul);
  176.         frame_rect(0,-1,638,188*mul);
  177.       end;
  178.       pnt_color(2);
  179.       paint_rect(192,10*mul,416,168*mul);
  180.       c1:=0;
  181.       y:=14;
  182.       while (y<174) do begin
  183.         if (c1 mod 2=0) then c:=0 else c:=1;
  184.         x:=200;
  185.         while (x<570) do begin
  186.           if (c mod 2=0) then pnt_color(1) else pnt_color(3);
  187.           paint_rect(x,y*mul,50,20*mul);
  188.           x:=x+50;
  189.           c:=c+1
  190.         end;
  191.       y:=y+20;
  192.       c1:=c1+1;
  193.       end;
  194.     show_mouse;
  195.     end;
  196.  
  197.   procedure set_menu;
  198.     var
  199.       c:integer;
  200.     begin
  201.       a_menu:=new_menu(30,'  About checkers...  ');
  202.       title1:=add_mtitle(a_menu,' Game ');
  203.       title2:=add_mtitle(a_menu,' Options ');
  204.       init_brd:=add_mitem(a_menu,title1,'  Initialize board  ');
  205.       strt_gme:=add_mitem(a_menu,title1,'  Start game        ');
  206.       edit_brd:=add_mitem(a_menu,title1,'  Edit board        ');
  207.       quit_edi:=add_mitem(a_menu,title1,'  Quit edit         ');
  208.       clr_brd :=add_mitem(a_menu,title1,'  Clear board       ');
  209.       can_mov :=add_mitem(a_menu,title1,'  Cancel move       ');
  210.       dline[1]:=add_mitem(a_menu,title1,'--------------------');
  211.       t_black :=add_mitem(a_menu,title1,'  Computer is red   ');
  212.       t_white :=add_mitem(a_menu,title1,'  Computer is white ');
  213.       dline[2]:=add_mitem(a_menu,title1,'--------------------');
  214.       red_top :=add_mitem(a_menu,title1,'  Red plays top     ');
  215.       red_bot :=add_mitem(a_menu,title1,'  Red plays bottom  ');
  216.       dline[3]:=add_mitem(a_menu,title1,'--------------------');
  217.       quit    :=add_mitem(a_menu,title1,'  Quit              ');
  218.       level[0]:=add_mitem(a_menu,title2,'  Level 0  (5  secs)  ');
  219.       level[1]:=add_mitem(a_menu,title2,'  Level 1  (30 secs)  ');
  220.       level[2]:=add_mitem(a_menu,title2,'  Level 2  (2  mins)  ');
  221.       level[3]:=add_mitem(a_menu,title2,'  Level 3  (5  mins)  ');
  222.       level[4]:=add_mitem(a_menu,title2,'  Level 4  (20 mins)  ');
  223.       level[5]:=add_mitem(a_menu,title2,'  Level 5  (2  hrs )  ');
  224.       level[6]:=add_mitem(a_menu,title2,'  Level 6  (8  hrs )  ');
  225.       for c:=1 to 3 do
  226.         menu_disable(a_menu,dline[c]);
  227.       draw_menu(a_menu);
  228.     end;
  229.  
  230.   procedure convert_s(i,j:integer; var n:integer);
  231.     begin
  232.       n:=(i-1) div 2+(j-1)*4+1;
  233.       if not top then n:=33-n;
  234.     end;
  235.  
  236.  procedure print_board;
  237.    var
  238.      i,j,n:integer;
  239.    begin
  240.      hide_mouse;
  241.      for n:=32 downto 1 do
  242.        if (brd[n]<>vixbrd[n]) or full then begin
  243.          case brd[n] of
  244.            -2:pnt_color(2);
  245.            -1:pnt_color(2);
  246.             0:pnt_color(3);
  247.             1:pnt_color(1);
  248.             2:pnt_color(1);
  249.           end;
  250.           convert_g(n,i,j);
  251.           if (brd[n]=0) then
  252.             paint_rect(50*i+150,(20*j-6)*mul,50,20*mul)
  253.           else begin
  254.             paint_oval(50*i+175,(20*j+3)*mul,18,-4);
  255.             paint_oval(50*i+175,(20*j+4)*mul,18,-4);
  256.           end;
  257.           pnt_color(0);
  258.           if abs(brd[n])=2 then begin
  259.             if mono then paint_style(5);
  260.             paint_rect(50*i+171,(20*j-2)*mul,9,12*mul);
  261.             paint_rect(50*i+163,(20*j+2)*mul,25,4*mul);
  262.           end;
  263.        end;
  264.      show_mouse;
  265.    end;
  266.  
  267.   procedure info;
  268.     var
  269.       dialog : Dialog_Ptr ;
  270.       button,
  271.       ok_btn,
  272.       prompt_item:integer;
  273.     begin
  274.         dialog := New_Dialog( 20, 0, 0, 40, 18 ) ;
  275.         prompt_item := Add_DItem( dialog, G_String, None, 12, 2, 0, 0, 0, 0 ) ;
  276.         Set_DText( dialog, prompt_item, 'ST CHECKERS 1.0',
  277.                         System_Font, TE_Center ) ;
  278.         prompt_item := Add_DItem( dialog, G_String, None, 12, 3, 0, 0, 0, 0 ) ;
  279.         Set_DText( dialog, prompt_item, '---------------',
  280.                         System_Font, TE_Center ) ;
  281.         prompt_item := Add_DItem( dialog, G_String, None, 11, 5, 0, 0, 0, 0 ) ;
  282.         Set_DText( dialog, prompt_item, 'by Pascal Parent',
  283.                         System_Font, TE_Center ) ;
  284.         prompt_item := Add_DItem( dialog, G_String, None, 11, 7, 0, 0, 0, 0 ) ;
  285.         Set_DText( dialog, prompt_item, 'ST adaptation by',
  286.                         System_Font, TE_Center ) ;
  287.         prompt_item := Add_DItem( dialog, G_String, None, 10, 9, 0, 0, 0, 0 ) ;
  288.         Set_DText( dialog, prompt_item, 'Francois Villeneuve',
  289.                         System_Font, TE_Center ) ;
  290.         prompt_item := Add_DItem( dialog, G_String, None, 8, 12, 0, 0, 0, 0 ) ;
  291.         Set_DText( dialog, prompt_item, 'Montreal, December 1986',
  292.                         System_Font, TE_Center ) ;
  293.         ok_btn := Add_DItem( dialog, G_Button, Selectable|Exit_Btn|Default,
  294.                         16, 14, 8, 2, 2, $1180 ) ;
  295.         Set_DText( dialog, ok_btn, 'OK', System_Font, TE_Center ) ;
  296.         Center_Dialog( dialog ) ;
  297.         button := Do_Dialog( dialog, 0 ) ;
  298.         end_dialog(dialog);
  299.         delete_dialog(dialog);
  300.     end;
  301.  
  302.   procedure redraw;
  303.     begin
  304.       if (which=E_Message) and (msg[3]=3) then begin
  305.        info;
  306.        menu_normal(a_menu,msg[3]);
  307.        which:=get_event( E_Message, 1, 1, 1, 0,
  308.               false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  309.               dummy, dummy, dummy, mx, my, dummy );
  310.       end;
  311.       if (which=E_Message) and (msg[0]=WM_Redraw) then begin
  312.         init_screen;
  313.         vixbrd:=clrbrd;
  314.         print_board;
  315.       end;
  316.     end;
  317.  
  318.   procedure setup;
  319.     label 30;
  320.     var
  321.       i,j,coul:integer;
  322.     begin
  323.       jedit:=true;
  324.       menu_enable(a_menu,quit_edi);
  325.       menu_enable(a_menu,clr_brd);
  326.       menu_disable(a_menu,edit_brd);
  327.       menu_disable(a_menu,strt_gme);
  328.       menu_disable(a_menu,init_brd);
  329.       menu_disable(a_menu,t_black);
  330.       menu_disable(a_menu,t_white);
  331.       menu_disable(a_menu,red_top);
  332.       menu_disable(a_menu,red_bot);
  333.       for i:=0 to 6 do
  334.         menu_disable(a_menu,level[i]);
  335.       repeat
  336.         which:=get_event( E_Message | E_Button, 1, 1, 1, 0,
  337.                false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  338.                dummy, dummy, dummy, mx, my, dummy );
  339.         menu_normal(a_menu,title1); menu_normal(a_menu,title2);
  340.         my:=trunc(my/mul);
  341.         if (which=E_Message) and (msg[4]=clr_brd) then begin
  342.           vixbrd:=brd;
  343.           brd:=clrbrd;
  344.           print_board;
  345.         end;
  346.         if (which=E_Message) and ((msg[0]=WM_Redraw) or (msg[3]=3))
  347.           then redraw;
  348.         if which=E_Message then goto 30;
  349.         if (which=e_button) and (mx>199) and (mx<601) and (my>13)
  350.            and (my<185) then begin
  351.           my:=my-12;
  352.           i:=((mx-200) div 50)+1;
  353.           j:=((my-14) div 20)+1;
  354.           if ((i mod 2=1) and (j mod 2=0)) or ((i mod 2=0) and (j mod 2=1))
  355.             then begin
  356.            convert_s(i,j,n);
  357.              case (brd[n]) of
  358.                 0:brd[n]:=-1;
  359.                -1:brd[n]:= 1;
  360.                 1:brd[n]:= 2;
  361.                 2:brd[n]:=-2;
  362.                -2:brd[n]:= 0;
  363.              end;
  364.              case (brd[n]) of
  365.                0:coul:=3;
  366.                -1:coul:=2;
  367.                 1:coul:=1;
  368.                -2:coul:=2;
  369.                 2:coul:=1;
  370.              end;
  371.              hide_mouse;
  372.              pnt_color(coul);
  373.              paint_oval((50*i+175),(20*j+3)*mul,18,-4);
  374.              paint_oval((50*i+175),(20*j+4)*mul,18,-4);
  375.              pnt_color(0);
  376.              if abs(brd[n])=2 then begin
  377.                 if mono then paint_style(5);
  378.                 paint_rect(50*i+171,(20*j-2)*mul,9,12*mul);
  379.                 paint_rect(50*i+163,(20*j+2)*mul,25,4*mul);
  380.              end;
  381.              show_mouse;
  382.             end;
  383.             which:=get_event( E_Button, 1, 0, 1, 0,
  384.                    false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  385.                    dummy, dummy, dummy, mx, my, dummy );
  386. 30:     end;
  387.       until (which=E_Message) and ((msg[4]=quit_edi) or (msg[4]=quit));
  388.       menu_disable(a_menu,clr_brd);
  389.       menu_enable(a_menu,edit_brd);
  390.       menu_enable(a_menu,strt_gme);
  391.       menu_enable(a_menu,init_brd);
  392.       menu_enable(a_menu,t_black);
  393.       menu_disable(a_menu,quit_edi);
  394.       menu_enable(a_menu,t_white);
  395.       menu_enable(a_menu,red_top);
  396.       menu_enable(a_menu,red_bot);
  397.       for i:=0 to 6 do
  398.         menu_enable(a_menu,level[i]);
  399.     end;
  400.  
  401.   procedure quit_prg;
  402.     var
  403.       c:integer;
  404.     begin
  405.       close_window(big_window);
  406.       for c:=0 to 3 do
  407.         dummy:=s_color(c,d_color[c]);
  408.     end;
  409.  
  410.   procedure print_message(b:string;wait:boolean);
  411.     begin
  412.       hide_mouse;
  413.       pnt_color(0);
  414.       paint_rect(10,17*mul,150,10*mul);
  415.       draw_mode(2);
  416.       if mono then text_color(0) else text_color(1);
  417.       draw_string(10,24*mul,b);
  418.       draw_mode(1);
  419.       show_mouse;
  420.     end;
  421.  
  422.  procedure skip(ss,pc:integer);
  423.   var
  424.    jfound,k,tmp,s1,s2: integer;
  425.   begin
  426.    tmv[tmvp]:=ss;
  427.    tmp:=tmvp;
  428.    tmvp:=tmvp+1;
  429.    jfound:=0;
  430.    if (sw2[ss]<>0) and (pc<>1) then
  431.     if (tkn[sw1[ss]]<1) and (brd[sw2[ss]]=0) then begin
  432.      if abs(brd[sw1[ss]])=2 then
  433.       tmv[tmp]:=-ss
  434.      else
  435.       tmv[tmp]:=ss;
  436.      tkn[sw1[ss]]:=2;
  437.      jfound:=1;
  438.      skip(sw2[ss],pc)
  439.     end;
  440.    if (se2[ss]<>0) and (pc<>1) then
  441.     if (tkn[se1[ss]]<1) and (brd[se2[ss]]=0) then begin
  442.      if abs(brd[se1[ss]])=2 then
  443.       tmv[tmp]:=-ss
  444.      else
  445.       tmv[tmp]:=ss;
  446.      tkn[se1[ss]]:=2;
  447.      jfound:=1;
  448.      skip(se2[ss],pc)
  449.     end;
  450.    if (nw2[ss]<>0) and (pc<>-1) then
  451.     if (tkn[nw1[ss]]<1) and (brd[nw2[ss]]=0) then begin
  452.      if abs(brd[nw1[ss]])=2 then
  453.       tmv[tmp]:=-ss
  454.      else
  455.       tmv[tmp]:=ss;
  456.      tkn[nw1[ss]]:=2;
  457.      jfound:=1;
  458.      skip(nw2[ss],pc)
  459.     end;
  460.    if (ne2[ss]<>0) and (pc<>-1) then
  461.     if (tkn[ne1[ss]]<1) and (brd[ne2[ss]]=0) then begin
  462.      if abs(brd[ne1[ss]])=2 then
  463.       tmv[tmp]:=-ss
  464.      else
  465.       tmv[tmp]:=ss;
  466.      tkn[ne1[ss]]:=2;
  467.      jfound:=1;
  468.      skip(ne2[ss],pc)
  469.     end;
  470.    if (tmvp>1) and (jfound=0) then begin
  471.     if ((ss>28) and (pc=-1)) or ((ss<5) and (pc=1)) then begin
  472.      tmv[tmvp]:=99;
  473.      tmvp:=tmvp+1
  474.     end;
  475.     mvlst[nextm]:=tmvp;
  476.     for k:=0 to tmvp-1 do
  477.      mvlst[nextm+k+1]:=tmv[k];
  478.     nextm:=nextm+12
  479.    end;
  480.    if tmp>0 then begin
  481.     tmvp:=tmp;
  482.     s1:=abs(tmv[tmp-1]);
  483.     s2:=abs(tmv[tmp]);
  484.     if sw2[s1]=s2 then
  485.      tkn[sw1[s1]]:=0
  486.     else if nw2[s1]=s2 then
  487.      tkn[nw1[s1]]:=0
  488.     else if ne2[s1]=s2 then
  489.      tkn[ne1[s1]]:=0
  490.     else if se2[s1]=s2 then
  491.      tkn[se1[s1]]:=0
  492.    end
  493.   end;
  494.  
  495.  procedure move(ss,pc:integer);
  496.   begin
  497.    if (sw1[ss]<>0) and (pc<>1) then
  498.     if brd[sw1[ss]]=0 then begin
  499.      mvlst[nextm+1]:=ss;
  500.      mvlst[nextm+2]:=sw1[ss];
  501.      mvlst[nextm]:=2;
  502.      if (sw1[ss]>28) and (pc=-1) then begin
  503.       mvlst[nextm+3]:=99;
  504.       mvlst[nextm]:=3
  505.      end;
  506.      nextm:=nextm+12
  507.     end;
  508.    if (se1[ss]<>0) and (pc<>1) then
  509.     if brd[se1[ss]]=0 then begin
  510.      mvlst[nextm+1]:=ss;
  511.      mvlst[nextm+2]:=se1[ss];
  512.      mvlst[nextm]:=2;
  513.      if (se1[ss]>28) and (pc=-1) then begin
  514.       mvlst[nextm+3]:=99;
  515.       mvlst[nextm]:=3
  516.      end;
  517.      nextm:=nextm+12
  518.     end;
  519.    if (nw1[ss]<>0) and (pc<>-1) then
  520.     if brd[nw1[ss]]=0 then begin
  521.      mvlst[nextm+1]:=ss;
  522.      mvlst[nextm+2]:=nw1[ss];
  523.      mvlst[nextm]:=2;
  524.      if (nw1[ss]<5) and (pc=1) then begin
  525.       mvlst[nextm+3]:=99;
  526.       mvlst[nextm]:=3
  527.      end;
  528.      nextm:=nextm+12
  529.     end;
  530.    if (ne1[ss]<>0) and (pc<>-1) then
  531.     if brd[ne1[ss]]=0 then begin
  532.      mvlst[nextm+1]:=ss;
  533.      mvlst[nextm+2]:=ne1[ss];
  534.      mvlst[nextm]:=2;
  535.      if (ne1[ss]<5) and (pc=1) then begin
  536.       mvlst[nextm+3]:=99;
  537.       mvlst[nextm]:=3
  538.      end;
  539.      nextm:=nextm+12
  540.     end
  541.   end;
  542.  
  543.  procedure movegen(lvl:integer);
  544.   var
  545.    mbeg,colr,c:integer;
  546.   begin
  547.    tmvp:=0;
  548.    if lvl mod 2=0 then
  549.     colr:=1
  550.    else
  551.     colr:=-1;
  552.    if plyr=-1 then
  553.     colr:=-colr;
  554.    mbeg:=360*lvl;
  555.    nextm:=mbeg;
  556.    for c:=1 to 32 do
  557.     if ((brd[c]<0) and (colr>0)) or ((brd[c]>0) and (colr<0)) then
  558.      tkn[c]:=0
  559.     else
  560.      tkn[c]:=1;
  561.    for c:=1 to 32 do
  562.     if (brd[c]<>0) and (tkn[c]<>0) then begin
  563.      tmvp:=0;
  564.      tpc:=brd[c];
  565.      brd[c]:=0;
  566.      skip(c,tpc);
  567.      brd[c]:=tpc
  568.     end;
  569.    if nextm=mbeg then
  570.     for c:=1 to 32 do
  571.      if (brd[c]<>0) and (tkn[c]<>0) then
  572.       move(c,brd[c]);
  573.    mvlst[nextm]:=0
  574.   end;
  575.  
  576.  procedure st(i,a,b,c,d,e,f,g,h,v:integer);
  577.   begin
  578.    sw1[i]:=a;
  579.    sw2[i]:=b;
  580.    nw1[i]:=c;
  581.    nw2[i]:=d;
  582.    ne1[i]:=e;
  583.    ne2[i]:=f;
  584.    se1[i]:=g;
  585.    se2[i]:=h;
  586.    kval[i]:=v;
  587.   end;
  588.  
  589.  procedure initarr;
  590.   var
  591.    c :integer;
  592.   begin
  593.    st(1,5,0,0,0,0,0,6,10,-30);
  594.    st(2,6,9,0,0,0,0,7,11,-30);
  595.    st(3,7,10,0,0,0,0,8,12,-30);
  596.    st(4,8,11,0,0,0,0,0,0,-30);
  597.    st(5,0,0,0,0,1,0,9,14,-30);
  598.    st(6,9,13,1,0,2,0,10,15,-15);
  599.    st(7,10,14,2,0,3,0,11,16,-15);
  600.    st(8,11,15,3,0,4,0,12,0,-15);
  601.    st(9,13,0,5,0,6,2,14,18,-15);
  602.    st(10,14,17,6,1,7,3,15,19,15);
  603.    st(11,15,18,7,2,8,4,16,20,15);
  604.    st(12,16,19,8,3,0,0,0,0,-30);
  605.    st(13,0,0,0,0,9,6,17,22,-30);
  606.    st(14,17,21,9,5,10,7,18,23,15);
  607.    st(15,18,22,10,6,11,8,19,24,30);
  608.    st(16,19,23,11,7,12,0,20,0,-15);
  609.    st(17,21,0,13,0,14,10,22,26,-15);
  610.    st(18,22,25,14,9,15,11,23,27,30);
  611.    st(19,23,26,15,10,16,12,24,28,15);
  612.    st(20,24,27,16,11,0,0,0,0,-30);
  613.    st(21,0,0,0,0,17,14,25,30,-30);
  614.    st(22,25,29,17,13,18,15,26,31,15);
  615.    st(23,26,30,18,14,19,16,27,32,15);
  616.    st(24,27,31,19,15,20,0,28,0,-15);
  617.    st(25,29,0,21,0,22,18,30,0,-15);
  618.    st(26,30,0,22,17,23,19,31,0,-15);
  619.    st(27,31,0,23,18,24,20,32,0,-15);
  620.    st(28,32,0,24,19,0,0,0,0,-30);
  621.    st(29,0,0,0,0,25,22,0,0,-30);
  622.    st(30,0,0,25,21,26,23,0,0,-30);
  623.    st(31,0,0,26,22,27,24,0,0,-30);
  624.    st(32,0,0,27,23,28,0,0,0,-30);
  625.    for c:=1 to 8 do
  626.     nx[c]:=0;
  627.    for c:=9 to 32 do
  628.     nx[c]:=c-8;
  629.    for c:=1 to 24 do
  630.     s[c]:=c+8;
  631.    for c:=25 to 32 do
  632.     s[c]:=0;
  633.    for c:=1 to 32 do
  634.     if (c-1) mod 4=0 then
  635.       wx[c]:=0
  636.     else
  637.       wx[c]:=c-1;
  638.    for c:=1 to 32 do
  639.     if (c-1) mod 4=3 then
  640.       e[c]:=0
  641.     else
  642.       e[c]:=c+1;
  643.   end;
  644.  
  645. function eval:integer;
  646.   var
  647.    score,n,w,b,bq,wq,cof : integer;
  648.    cond                  : boolean;
  649.   begin
  650.    score:=0;
  651.    w:=0;
  652.    b:=0;
  653.    bq:=0;
  654.    wq:=0;
  655.    for n:=1 to 32 do
  656.      case brd[n] of
  657.       -2: bq:=bq+1;
  658.       -1: b:=b+1;
  659.        1: w:=w+1;
  660.        2: wq:=wq+1;
  661.      end;
  662.    if w+wq=0 then
  663.     score:=-31000
  664.    else if b+bq=0 then
  665.     score:=31000
  666.    else begin
  667.     score:=w*1000+wq*2000-b*1000-bq*2000;
  668.     for n:=5 to 28 do
  669.      if brd[n]>0 then begin
  670.       if brd[sw1[n]]>0 then
  671.        score:=score+8;
  672.       if brd[se1[n]]>0 then
  673.        score:=score+8
  674.      end
  675.      else if brd[n]<0 then begin
  676.       if brd[nw1[n]]<0 then
  677.        score:=score-8;
  678.       if brd[ne1[n]]<0 then
  679.        score:=score-8
  680.      end;
  681.     if bq<2 then
  682.      for n:=29 to 32 do
  683.       if brd[n]=1 then
  684.        score:=score+25;
  685.     if wq<2 then
  686.      for n:=1 to 4 do
  687.       if brd[n]=-1 then
  688.        score:=score-25;
  689.    end;
  690.    if plyr=-1 then
  691.     score:=-score;
  692.    if abs(score)<>31000 then begin
  693.     cof:=1;
  694.     if plyr=-1 then begin
  695.      if b<5 then cof:=10;
  696.      score:=score+(b-wq)*20;
  697.      for w:=5 to 28 do
  698.       if brd[w]=-1 then
  699.        score:=score+((w-1) div 4)*cof
  700.     end;
  701.     if plyr=1 then begin
  702.      if w<5 then cof:=10;
  703.      score:=score+(w-bq)*20;
  704.      for w:=5 to 28 do
  705.       if brd[w]=1 then
  706.        score:=score+((7-(w-1)) div 4)*cof
  707.     end;
  708.     if (wq>0) or (bq>0) then
  709.       for n:=1 to 32 do
  710.        case brd[n] of
  711.         -2 : begin
  712.                if plyr=-1 then
  713.                  score:=score+kval[i]
  714.                else if wq>=bq then begin
  715.                 if brd[nw2[n]]=2 then
  716.                  score:=score+50;
  717.                 if brd[sw2[n]]=2 then
  718.                  score:=score+50;
  719.                 if brd[ne2[n]]=2 then
  720.                  score:=score+50;
  721.                 if brd[se2[n]]=2 then
  722.                  score:=score+50;
  723.                 if brd[nx[n]]=2 then
  724.                  score:=score+100;
  725.                 if brd[s[n]]=2 then
  726.                  score:=score+100;
  727.                 if brd[e[n]]=2 then
  728.                  score:=score+100;
  729.                 if brd[wx[n]]=2 then
  730.                  score:=score+100;
  731.                end;
  732.              end;
  733.          2 : begin
  734.                if plyr=1 then
  735.                  score:=score+kval[i]
  736.                else if bq>=wq then begin
  737.                 if brd[nw2[n]]=-2 then
  738.                  score:=score+50;
  739.                 if brd[sw2[n]]=-2 then
  740.                  score:=score+50;
  741.                 if brd[ne2[n]]=-2 then
  742.                  score:=score+50;
  743.                 if brd[se2[n]]=-2 then
  744.                  score:=score+50;
  745.                 if brd[nx[n]]=-2 then
  746.                  score:=score+100;
  747.                 if brd[s[n]]=-2 then
  748.                  score:=score+100;
  749.                 if brd[e[n]]=-2 then
  750.                  score:=score+100;
  751.                 if brd[wx[n]]=-2 then
  752.                  score:=score+100;
  753.                end;
  754.              end;
  755.        end;
  756.    end;
  757.    eval:=score
  758.   end;
  759.  
  760.  procedure restore(pos:integer);
  761.   var
  762.    cnt,rs,rsc,pc,sq1,sq2 :integer;
  763.   begin
  764.    cnt:=mvlst[pos]+pos;
  765.    if mvlst[cnt]=99 then begin
  766.     cnt:=cnt-1;
  767.     pc:=brd[mvlst[cnt]] div 2
  768.    end
  769.    else
  770.     pc:=brd[mvlst[cnt]];
  771.    if pc<0 then
  772.     rs:=1
  773.    else
  774.     rs:=-1;
  775.    if abs(abs(mvlst[cnt])-abs(mvlst[cnt-1]))<6 then begin
  776.     brd[mvlst[cnt-1]]:=pc;
  777.     brd[mvlst[cnt]]:=0
  778.    end
  779.    else
  780.     while cnt>pos+1 do begin
  781.      sq2:=abs(mvlst[cnt]);
  782.      sq1:=abs(mvlst[cnt-1]);
  783.      if se2[sq2]=sq1 then
  784.       rsc:=se1[sq2]
  785.      else if sw2[sq2]=sq1 then
  786.       rsc:=sw1[sq2]
  787.      else if nw2[sq2]=sq1 then
  788.       rsc:=nw1[sq2]
  789.      else if ne2[sq2]=sq1 then
  790.       rsc:=ne1[sq2];
  791.      brd[sq2]:=0;
  792.      brd[sq1]:=pc;
  793.      if mvlst[cnt-1]>0 then
  794.       brd[rsc]:=rs
  795.      else
  796.       brd[rsc]:=rs*2;
  797.      cnt:=cnt-1
  798.     end
  799.   end;
  800.  
  801.  procedure update(pos:integer);
  802.   var
  803.    lst,cnt,pc,klc,sq1,sq2 : integer;
  804.   begin
  805.    cnt:=pos+1;
  806.    pc:=brd[abs(mvlst[cnt])];
  807.    lst:=mvlst[pos]+pos;
  808.    if mvlst[lst]=99 then begin
  809.     lst:=lst-1;
  810.     pc:=pc*2
  811.    end;
  812.    if abs(abs(mvlst[cnt])-abs(mvlst[cnt+1]))<6 then begin
  813.     brd[mvlst[cnt]]:=0;
  814.     brd[mvlst[cnt+1]]:=pc
  815.    end
  816.    else
  817.     while cnt<lst do begin
  818.      sq1:=abs(mvlst[cnt]);
  819.      sq2:=abs(mvlst[cnt+1]);
  820.      if ne2[sq1]=sq2 then
  821.       klc:=ne1[sq1]
  822.      else if nw2[sq1]=sq2 then
  823.       klc:=nw1[sq1]
  824.      else if sw2[sq1]=sq2 then
  825.       klc:=sw1[sq1]
  826.      else if se2[sq1]=sq2 then
  827.       klc:=se1[sq1];
  828.      brd[sq1]:=0;
  829.      brd[klc]:=0;
  830.      brd[sq2]:=pc;
  831.      cnt:=cnt+1
  832.     end
  833.    end;
  834.  
  835.  procedure getmove;
  836.   label 5;
  837.   var
  838.    square,pnt,p              : integer;
  839.    mv                        : array[1..12] of integer;
  840.    fnd,found,fin,first,pr,ok : boolean;
  841.   begin
  842.    alok:=false;
  843.    fnd:=false;
  844.    movegen(1);
  845.    p:=361;
  846.    while not fnd and (mvlst[p-1]<>0) do begin
  847.     if abs(mvlst[p])=code then fnd:=true;
  848.     p:=p+12
  849.    end;
  850.    if fnd then begin
  851.  
  852.    plyr:=-plyr;
  853.    alok:=true;
  854.    movegen(0);
  855.    first:=true;
  856.    if mvlst[0]<>0 then begin
  857.     repeat
  858.      if first then begin
  859.       mv[1]:=code;
  860.       square:=2
  861.      end
  862.      else
  863.       square:=square-1;
  864.      first:=false;
  865.      fin:=false;
  866.      repeat
  867.       menu_enable(a_menu,can_mov);
  868.       convert_g(mv[square-1],i,j);
  869.       line_color(0);
  870.       if mono then line_color(1);
  871.       rectangle;
  872.       if square>2 then begin
  873.         convert_g(mv[square-2],i,j);
  874.         line_color(3);
  875.         rectangle;
  876.       end;
  877.       repeat
  878.         which:=get_event( E_Message | E_Button, 1, 1, 1, 0,
  879.                false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  880.                dummy, dummy, dummy, mx, my, dummy );
  881.         my:=trunc(my/mul);
  882.         if (which=E_Message) and (msg[4]=can_mov) then begin
  883.           line_color(3);
  884.           menu_normal(a_menu,msg[3]);
  885.           for p:=1 to square do begin
  886.            convert_g(mv[p],i,j);
  887.            if mono then begin
  888.              hide_mouse;
  889.              paint_style(6);
  890.              paint_rect(50*i+150,(20*j-6)*mul,50,20*mul);
  891.              vixbrd[mv[p]]:=0;
  892.              print_board;
  893.              show_mouse;
  894.            end
  895.            else rectangle;
  896.           end;
  897.           alok:=false;
  898.           plyr:=-plyr;
  899.           goto 5;
  900.         end;
  901.         my:=my-12;
  902.         i:=((mx-200) div 50)+1;
  903.         j:=((my-14) div 20)+1;
  904.         if (which=e_button) and (mx>199) and (mx<601) and (my>1)
  905.            and (my<173) then ok:=true
  906.         else ok:=false;
  907.         if ((i mod 2=0) and (j mod 2=0)) or ((i mod 2=1) and (j mod 2=1))
  908.           then ok:=false;
  909.       until ok and (which=E_Button);
  910.       convert_s(i,j,n);
  911.       mv[square]:=n;
  912.       pr:=false;
  913.       p:=0;
  914.       fnd:=false;
  915.       while (mvlst[p]<>0) and (not fnd) do begin
  916.        found:=true;
  917.        for pnt:=1 to square do
  918.         if abs(mvlst[pnt+p])<>mv[pnt] then
  919.          found:=false;
  920.        if found then
  921.         fnd:=true;
  922.        p:=p+12
  923.       end;
  924.       p:=p-12;
  925.       square:=square+1;
  926.       if ((mvlst[square+p]=99) or (square>mvlst[p])) and (fnd) then
  927.        fin:=true
  928.      until (fin) or (not fnd)
  929.     until fin
  930.    end;
  931.    lm:=mv;
  932.    convert_g(mv[square-2],i,j);
  933.    line_color(3);
  934.    if mono then line_color(0);
  935.    rectangle;
  936.    update(p);
  937.    plyr:=-plyr;
  938.    movegen(0);
  939.    if (eval<-30000) or (mvlst[0]=0) then begin
  940.     print_message('I LOSE...',false);
  941.     over:=true;
  942.     alok:=false;
  943.    end
  944.  
  945.   end;
  946.   menu_disable(a_menu,can_mov);
  947.   which:=get_event( E_Button, 1, 0, 1, 0,
  948.                false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  949.                dummy, dummy, dummy, mx, my, dummy );
  950. 5:end;
  951.  
  952.  procedure alphbet;
  953.   label
  954.    20;
  955.   var
  956.    score                              : array[-1..MAXP1] of integer;
  957.    mp                                 : array[0..MAXP1] of integer;
  958.    ply,c,d,f,r1,r2,h,maxsr            : integer;
  959.    tt                                 : integer;
  960.    xt,any,prdone,diff                 : boolean;
  961.   function t_settime(time:integer):integer;
  962.    gemdos($2d);
  963.   begin
  964.    sonia:='                              ';
  965.    set_mouse(M_Bee);
  966.    oldbrd:=brd;
  967.    tt:=t_settime(0);
  968.    score[1]:=eval;
  969.    movegen(0);
  970.    if (mvlst[12]=0) and not near then begin
  971.     for c:=0 to 11 do
  972.      princ[c+12,1]:=mvlst[c];
  973.     set_mouse(M_Arrow);
  974.     show_move(0);
  975.     update(0);
  976.     goto 20
  977.    end;
  978.    maxsr:=1;
  979.    if timelim=0 then
  980.     maxsr:=4;
  981.  
  982.    repeat
  983.  
  984.    sonia[maxsr]:='.';
  985.    if timelim<>0 then
  986.     print_message(sonia,false);
  987.    score[-1]:=-32000;
  988.    score[0]:=32000;
  989.    ply:=0;
  990.    prdone:=false;
  991.    if timelim=0 then
  992.     prdone:=true;
  993.    repeat
  994.     any:=true;
  995.     while (ply<>maxsr) and any do begin
  996.      movegen(ply);
  997.      if (not prdone) and (maxsr<>1) then begin
  998.        d:=ply*360;
  999.        diff:=true;
  1000.        while (mvlst[d]<>0) and (diff) do begin
  1001.         diff:=false;
  1002.         for c:=0 to mvlst[d] do
  1003.          if mvlst[d+c]<>princ[12*ply+12+c,1] then
  1004.           diff:=true;
  1005.         d:=d+12
  1006.        end;
  1007.        if not diff then begin
  1008.         d:=d-12;
  1009.         for c:=0 to 11 do begin
  1010.          mvlst[d+c]:=mvlst[360*ply+c];
  1011.          mvlst[360*ply+c]:=princ[12*ply+12+c,1]
  1012.         end
  1013.        end
  1014.        else
  1015.         prdone:=true;
  1016.        if ply=maxsr-1 then
  1017.         prdone:=true
  1018.       end;
  1019.      if mvlst[ply*360]=0 then
  1020.       any:=false;
  1021.      if any then begin
  1022.       score[ply+1]:=score[ply-1];
  1023.       mp[ply+1]:=360*ply;
  1024.       ply:=ply+1;
  1025.       update(mp[ply]);
  1026.      end
  1027.     end;
  1028.     if not any then
  1029.      if ply mod 2=0 then
  1030.       score[ply+1]:=-31000
  1031.      else
  1032.       score[ply+1]:=31000
  1033.     else
  1034.       score[ply+1]:=eval;
  1035.     xt:=false;
  1036.     repeat
  1037.      if ((ply mod 2=0) and (score[ply+1]<=score[ply-1])) or
  1038.         ((ply mod 2=1) and (score[ply+1]>=score[ply-1])) then begin
  1039.       restore(mp[ply]);
  1040.       ply:=ply-1
  1041.      end
  1042.      else if ((ply mod 2=0) and (score[ply+1]<score[ply])) or
  1043.              ((ply mod 2=1) and (score[ply+1]>score[ply])) then begin
  1044.       score[ply]:=score[ply+1];
  1045.       if ply<maxsr then begin
  1046.        r1:=(ply+1)*12;
  1047.        r2:=maxsr*12+11;
  1048.        for h:=r1 to r2 do
  1049.         princ[h,ply]:=princ[h,ply+1]
  1050.       end;
  1051.       r1:=ply*12;
  1052.       for h:=0 to 11 do
  1053.        princ[r1+h,ply]:=mvlst[mp[ply]+h];
  1054.       if ply=1 then
  1055.        disp_move;
  1056.      end;
  1057.      restore(mp[ply]);
  1058.      ply:=ply-1;
  1059.      if mvlst[mp[ply+1]+12]<>0 then
  1060.       xt:=true
  1061.     until (xt) or (ply=0);
  1062.     if (ply<>0) or xt then begin
  1063.      mp[ply+1]:=mp[ply+1]+12;
  1064.      ply:=ply+1;
  1065.      update(mp[ply]);
  1066.     end;
  1067.    until (ply=0) and (not xt);
  1068.  
  1069.    maxsr:=maxsr+1;
  1070.    until (maxsr=dmax+1) or (score[1]=31000)
  1071.     or ((clock>timelim) and (maxsr>6));
  1072.  
  1073.    hide_mouse;
  1074.    pnt_color(3);
  1075.    for c:=13 to lij do
  1076.     if (ii[c]<>0) and (jj[c]<>0) then begin
  1077.      i:=ii[c];
  1078.      j:=jj[c];
  1079.      paint_rect(50*i+150,(20*j-6)*mul,10,4*mul)
  1080.     end;
  1081.    pnt_color(0);
  1082.    show_mouse;
  1083.    brd:=oldbrd;
  1084.    hide_mouse;
  1085.    paint_rect(10,17*mul,170,10*mul);
  1086.    show_mouse;
  1087.    for d:=12 to 23 do
  1088.     mvlst[d]:=princ[d,1];
  1089.    if (score[1]=31000) and ((maxsr-2) div 2<>0) and (timelim<>0) then begin
  1090.     sonia:='I win in   ... ';
  1091.     near:=true;
  1092.     sonia[10]:=chr((maxsr-2) div 2+ord('0'));
  1093.     print_message(sonia,false);
  1094.    end;
  1095.    set_mouse(M_arrow);
  1096.    show_move(12);
  1097.    update(12);
  1098. 20:
  1099.    movegen(1);
  1100.    if (eval>30000) or (mvlst[360]=0) then begin
  1101.     print_message('*** I WIN! ***',false);
  1102.     over:=true
  1103.    end
  1104.  end;
  1105.  
  1106.  procedure init;
  1107.   var
  1108.    ans     : char;
  1109.    ac      : array[1..4] of char;
  1110.    row,i,sq: integer;
  1111.   begin
  1112.     for sq:=1 to 12 do
  1113.      brd[sq]:=-1;
  1114.     for sq:=13 to 20 do
  1115.      brd[sq]:=0;
  1116.     for sq:=21 to 32 do
  1117.      brd[sq]:=1;
  1118.   end;
  1119.  
  1120.  begin
  1121.    if init_gem>=0 then begin
  1122.      init_mouse;
  1123.      mono:=false; mul:=1;
  1124.      for c:=1 to 32 do
  1125.        brd[c]:=0;
  1126.      vixbrd:=brd;
  1127.      clrbrd:=brd;
  1128.      jedit:=false;
  1129.      jinit:=false;
  1130.      near:=false;
  1131.      full:=false;
  1132.      brd[0]:=0;
  1133.      ok:=true;
  1134.      init_screen;
  1135.      set_menu;
  1136.      menu_disable(a_menu,quit_edi);
  1137.      menu_disable(a_menu,clr_brd);
  1138.      menu_disable(a_menu,strt_gme);
  1139.      menu_disable(a_menu,can_mov);
  1140.      menu_check(a_menu,t_white,true);
  1141.      menu_check(a_menu,red_bot,true);
  1142.      menu_check(a_menu,level[0],true);
  1143.      initarr;
  1144.      lij:=13;
  1145.      ii[13]:=2;
  1146.      jj[13]:=1;
  1147.      over:=true;
  1148.      plyr:=1;
  1149.      top:=false;
  1150.      timelim:=0;
  1151.      dmax:=4;
  1152.      repeat
  1153.        which:=get_event( E_Message | E_Button, 1, 1, 1, 0,
  1154.               false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  1155.               dummy, dummy, dummy, mx, my, dummy );
  1156.        my:=trunc(my/mul);
  1157.        if ok then begin
  1158.          which:=E_Timer;
  1159.          ok:=false;
  1160.        end;
  1161.        if (which=E_Message) and ((msg[0]=WM_Redraw) or (msg[3]=3))
  1162.          then redraw;
  1163.        if (which=e_button) and (mx>199) and (mx<601) and (my>13)
  1164.            and (my<185) and not over then begin
  1165.          my:=my-12;
  1166.          i:=((mx-200) div 50)+1;
  1167.          j:=((my-14) div 20)+1;
  1168.          if ((i mod 2=1) and (j mod 2=0)) or ((i mod 2=0) and (j mod 2=1))
  1169.            then begin
  1170.              convert_s(i,j,code);
  1171.              vixbrd:=brd;
  1172.              getmove;
  1173.              print_board;
  1174.              if alok then begin
  1175.               vixbrd:=brd;
  1176.               if not jinit then
  1177.                alphbet
  1178.               else begin
  1179.                jinit:=false;
  1180.                mvlst[0]:=2;
  1181.                if (lm[1]=9) and (lm[2]=13) then begin
  1182.                  mvlst[1]:=22;
  1183.                  mvlst[2]:=18;
  1184.                end;
  1185.                if (lm[1]=9) and (lm[2]=14) then begin
  1186.                  mvlst[1]:=22;
  1187.                  mvlst[2]:=18;
  1188.                end;
  1189.                if (lm[1]=10) and (lm[2]=14) then begin
  1190.                  mvlst[1]:=22;
  1191.                  mvlst[2]:=17;
  1192.                end;
  1193.                if (lm[1]=10) and (lm[2]=15) then begin
  1194.                  mvlst[1]:=21;
  1195.                  mvlst[2]:=17;
  1196.                end;
  1197.                if (lm[1]=11) and (lm[2]=15) then begin
  1198.                  mvlst[1]:=23;
  1199.                  mvlst[2]:=18;
  1200.                end;
  1201.                if (lm[1]=11) and (lm[2]=16) then begin
  1202.                  mvlst[1]:=22;
  1203.                  mvlst[2]:=18;
  1204.                end;
  1205.                if (lm[1]=12) and (lm[2]=16) then begin
  1206.                  mvlst[1]:=24;
  1207.                  mvlst[2]:=20;
  1208.                end;
  1209.                show_move(0);
  1210.                vixbrd:=brd;
  1211.                update(0);
  1212.                print_board;
  1213.               end;
  1214.               print_board
  1215.              end;
  1216.            end;
  1217.          end;
  1218.        if (msg[3]=title1) and (which=E_Message) then begin
  1219.          menu_normal(a_menu,msg[3]);
  1220.          if (msg[4]=edit_brd) then begin
  1221.            jinit:=false;
  1222.            hide_mouse;
  1223.            pnt_color(0);
  1224.            paint_rect(10,17*mul,150,10*mul);
  1225.            show_mouse;
  1226.            setup;
  1227.            for c:=1 to 32 do
  1228.              if (brd[c]<>0) then
  1229.                menu_enable(a_menu,strt_gme);
  1230.            over:=true;
  1231.            near:=false;
  1232.          end
  1233.          else if msg[4]=strt_gme then begin
  1234.            which:=get_event( E_Button, 1, 0, 1, 0,
  1235.                false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  1236.                dummy, dummy, dummy, mx, my, dummy );
  1237.            over:=false;
  1238.            if jedit then begin
  1239.             jedit:=false;
  1240.             vixbrd:=brd;
  1241.             movegen(0);
  1242.             if mvlst[0]<>0 then begin
  1243.              alphbet;
  1244.              print_board;
  1245.             end
  1246.             else begin
  1247.              print_message('I LOSE...',false);
  1248.              over:=true;
  1249.              print_board;
  1250.             end
  1251.            end
  1252.            else if plyr=-1 then begin
  1253.              jinit:=false;
  1254.              sq:=abs(gia_read(0) mod 100);
  1255.              mvlst[0]:=2;
  1256.              mvlst[1]:=11;
  1257.              mvlst[2]:=15;
  1258.              if sq<50 then begin
  1259.                mvlst[0]:=2;
  1260.                mvlst[1]:=9;
  1261.                mvlst[2]:=14
  1262.              end;
  1263.              show_move(0);
  1264.              vixbrd:=brd;
  1265.              update(0);
  1266.              print_board;
  1267.            end;
  1268.            menu_disable(a_menu,strt_gme);
  1269.          end
  1270.          else if (msg[4]=init_brd) then begin
  1271.            jinit:=true;
  1272.            jedit:=false;
  1273.            hide_mouse;
  1274.            pnt_color(0);
  1275.            paint_rect(10,17*mul,150,10*mul);
  1276.            show_mouse;
  1277.            vixbrd:=brd;
  1278.            init;
  1279.            near:=false;
  1280.            over:=true;
  1281.            full:=true;
  1282.            print_board;
  1283.            full:=false;
  1284.            menu_enable(a_menu,strt_gme);
  1285.          end
  1286.          else if (msg[4]=red_top) then begin
  1287.                top:=true;
  1288.                menu_check(a_menu,red_bot,false);
  1289.                menu_check(a_menu,red_top,true);
  1290.                vixbrd:=clrbrd;
  1291.                full:=true;
  1292.                print_board;
  1293.                full:=false;
  1294.          end
  1295.          else if (msg[4]=red_bot) then begin
  1296.                menu_check(a_menu,red_bot,true);
  1297.                menu_check(a_menu,red_top,false);
  1298.                top:=false;
  1299.                vixbrd:=clrbrd;
  1300.                full:=true;
  1301.                print_board;
  1302.                full:=false;
  1303.          end
  1304.          else if (msg[4]=t_black) then begin
  1305.            menu_check(a_menu,t_black,true);
  1306.            menu_check(a_menu,t_white,false);
  1307.            jinit:=false;
  1308.            if plyr=1 then begin
  1309.              plyr:=-1;
  1310.              if not over then begin
  1311.                vixbrd:=brd;
  1312.                alphbet;
  1313.                print_board;
  1314.              end;
  1315.            end;
  1316.          end
  1317.          else if (msg[4]=t_white) then begin
  1318.            jinit:=false;
  1319.            menu_check(a_menu,t_black,false);
  1320.            menu_check(a_menu,t_white,true);
  1321.            if plyr=-1 then begin
  1322.              plyr:=1;
  1323.              if not over then begin
  1324.                vixbrd:=brd;
  1325.                alphbet;
  1326.                print_board;
  1327.              end;
  1328.            end;
  1329.          end;
  1330.        end;
  1331.        if (which=E_Message) and (msg[3]=title2) then begin
  1332.          menu_normal(a_menu,msg[3]);
  1333.          for c:=0 to 6 do begin
  1334.            menu_check(a_menu,level[c],false);
  1335.            if (msg[4]=level[c]) then begin
  1336.              case c of
  1337.                0:timelim:=0;
  1338.                1:timelim:=15;
  1339.                2:timelim:=60;
  1340.                3:timelim:=150;
  1341.                4:timelim:=600;
  1342.                5:timelim:=3600;
  1343.                6:timelim:=14400;
  1344.              end;
  1345.              if c=0 then
  1346.               dmax:=4
  1347.              else
  1348.               dmax:=MAX;
  1349.              menu_check(a_menu,level[c],true);
  1350.            end;
  1351.          end;
  1352.        end;
  1353.        until (which=E_Message) and (msg[4]=quit);
  1354.      end;
  1355. 50:  quit_prg;
  1356.    end.
  1357. əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə